home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tpwspy.arc
/
TPWSPY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-07-25
|
39KB
|
952 lines
program TPWSpy;
(*
Program: TPWPSY.PAS
Version: 1.0
Date: July 26, 1991
Operating System: MS-DOS 3.0 or greater
Windows 3.0 or greater
Programming System: Turbo Pascal for Windows 1.0
Author: Translation by Craig Boyd
Based on SPY.C by Michael Geary
Update History
update ver description (author)
------- --- -----------
9107.18 0.0 Work begun. (CSB)
9107.26 1.0 Released to public domain. (CSB)
Description:
A TPW version of SPY.C. This version uses the Windows API and does not
incorporate ObjectWindows. In other words, I did it the hard way!
This program is based on the version of Spy described in an article by
Michael Geary which appeared in the 1987 All-IBM issue of Byte magazine.
The source code to this version of Spy was originally downloaded from
the BYTEnet BBS. As far as I can tell, Mr. Geary wrote Spy for his own
use, and Microsoft later altered the program and added it to the Windows
Software Development Kit. Since Michael released his version of the
program to the public domain, I see no problem with making my own
version and distributing it as I please. The version of Spy that
currently ships with the SDK may be quite different (I've never seen
it), but some may find this version of interest. Do with it what you
will.
This translation is functionally identical to the original version. The
only thing I've added is a Font menu, so you can play with the look of
the output a little bit. TPWSpy defaults to the System Fixed font,
which is the same as the system font used in Windows 2.x. You can
choose between that and the OEM fixed font and the System variable font.
I've left in all of Mr. Geary's original comments, although some text
has been altered to reflect the change from C to Pascal. There's a lot
of useful information here, especially the bit about eating wm_size
messages until the program is fully initialized.
Thanks to J. W. Rider, Pat Ritchey, and Richard R. Sands for helping me
get a handle on some difficult to grasp (at least to me) TPW concepts
and for helping me figure out how to translate some of the more esoteric
C algorithms into Pascal.
Craig Boyd
July, 1991
-------------------------------------------------------------------------
Windows Spy Program
Public Domain
Written by Michael Geary
This program "spies" on all the windows that are currently open in your
Windows session, and displays a window containing all the information it
can find out about those windows. You can scroll through this window
using either the mouse or keyboard to view the information about the
various windows. The "New Spy Mission" menu item re-captures the latest
information. This menu item is on the System menu so you can trigger it
even if the Spy window is iconic. (Translator's note: no it isn't!)
The display for a single window looks like this in collapsed mode:
{Child|Popup|TopLevel} window HHHH {class} (L,T;R,B) "title"
or like this in expanded mode:
{Child|Popup|TopLevel} window handle: HHHH
Class name: {class name}
Window title: {title text}
Parent window handle: HHHH
Class function, window function: HHHH:HHHH, HHHH:HHHH
Class module handle, Window instance handle: HHHH, HHHH
Class extra alloc, Window extra alloc: DDDD, DDDD
Class style, Window style: HHHH, HHHHHHHH
Menu handle: HHHH -or- Control ID: DDDD
Brush, Cursor, Icon handles: HHHH, HHHH, HHHH
Window rectangle: Left=DDDD, Top=DDDD, Right=DDDD, Bottom=DDDD
Client rectangle: Left=DDDD, Top=DDDD, Right=DDDD, Bottom=DDDD
{blank line}
Total number of lines for one window display: 13
*)
{R-} { hint: keep range checking on until your code is FULLY debugged! }
{$R TPWSPY} { resource file }
uses WinTypes, WinProcs;
const
Cmd_Spy = 101; { menu command }
Cmd_Expand = 102; { menu command }
Cmd_OEMFixedFont = 103; { menu command }
Cmd_SystemFixedFont = 104; { menu command }
Cmd_SystemFont = 105; { menu command }
Ids_Class = 1; { string resource }
Ids_Title = 2; { string resource }
MaxLinesPerWin = 13;
WindowWidth = 120;
vk_MinCursor = vk_prior;
vk_MaxCursor = vk_down;
ClassMax = 30;
TitleMax = 50;
Initted : bool = false; { TRUE when initialized }
bExpand : bool = false; { Expanded display mode? }
LinesPerWin : integer = 1; { 1 or MaxLinesPerWin }
FontTable : array[Cmd_OEMFixedFont..Cmd_SystemFont] of integer = (
OEM_Fixed_Font,
System_Fixed_Font,
System_Font);
DefaultFont = System_Fixed_Font; { default font }
DefaultFontCmd = Cmd_SystemFixedFont; { default font command }
SpyFont : integer = DefaultFont; { current font }
SpyFontCmd : word = DefaultFontCmd; { current font command }
type
{
The INFO record contains all the information we gather up about each
window we are spying on. We allocate an array of INFO records in the
global heap, with one entry for each window in the system.
}
Info = record
winHWnd : hwnd; { Window handle }
winClass : array[0..ClassMax] of char; { Class name }
winBkgdBrush : hbrush; { Background brush handle }
winCursor : hcursor; { Cursor handle }
winIcon : hicon; { Icon handle }
winClassModule : thandle; { Module handle for owner of class }
winWndExtra : word; { Extra data allocated for each window }
winClsExtra : word; { Extra data allocated in class itself }
winClassStyle : word; { Class style word }
winClassProc : longint; { Window function declared for class }
winInstance : thandle; { Instance handle for window owner }
winHWndParent : hwnd; { Parent window handle }
winTitle : array[0..titleMax] of char; { Window title }
winControlID : word; { Control ID or menu handle }
winWndProc : longint; { Window function, usually = class fun. }
winStyle : longint; { Style doubleword for window (WS_...) }
winWindowRect : trect; { Window rectangle (screen-relative) }
winClientRect : trect; { Client rectangle within window rect. }
end;
CsrMsg = record
csBar, { which scroll bar this key is equivalent to }
csMsg : byte; { the scroll message for this key }
end;
const
{
The CsrScroll array is used for implementing keyboard scrolling. By
looking up the keystroke in this array, we get the equivalent scroll
bar message.
}
CsrScroll : array[0..7] of CsrMsg = (
(csBar : sb_vert; csMsg : sb_pageup), { vk_prior (pgup) }
(csBar : sb_vert; csMsg : sb_pagedown), { vk_next (pgdn) }
(csBar : sb_vert; csMsg : sb_bottom), { vk_end (end) }
(csBar : sb_vert; csMsg : sb_top), { vk_home (home) }
(csBar : sb_horz; csMsg : sb_lineup), { vk_left (left arrow) }
(csBar : sb_vert; csMsg : sb_lineup), { vk_up (up arrow) }
(csBar : sb_horz; csMsg : sb_linedown), { vk_right (right arrow) }
(csBar : sb_vert; csMsg : sb_linedown)); { vk_down (down arrow) }
MaxWinNum = 64000 div sizeof(Info); { determined at compile time }
type
InfoArray = array[0..MaxWinNum] of Info;
var
hInst : thandle; { Our instance handle }
hInfo : thandle; { Global handle to INFO array }
pInfo : ^InfoArray;{ Far pointer to INFO, when locked down }
InfoIndex : integer; { index into INFO array }
nWindows : integer; { Total number of windows in system }
dwInfoSize : longint; { Size of entire INFO array in bytes }
lpprocCountWindow, { ProcInstance for CountWindow }
lpprocSpyOnWindow : tfarproc; { ProcInstance for SpyOnWindow }
nCharSizeX, { Width of a character in pixels }
nCharSizeY, { Height of a character in pixels }
nExtLeading, { # pixels vertical space between chars }
nPaintX, { For Paint function: X coordinate }
nPaintY : integer; { For Paint function: Y coordinate }
hdcPaint : HDC; { For Paint function: hDC to paint into }
szClass : array[0..10] of char; { Our window class name }
szTitle : array[0..40] of char; { Our window title }
{------------------------------------------------------------------------}
function CountWindow(hWin : hwnd; { Window handle }
TopLevel : longint) : bool; export;
{
Enumeration function to count the number of windows in the system.
Called once for each window, via EnumWindows and recursively via
EnumChildWindows. The TopLevel parameter tells us which kind of
call it is. 1=top level window, 0=child window.
}
begin
{ Count the window }
inc(dwInfoSize,sizeof(Info));
inc(nWindows);
{ If this is a top level window (or popup), count its children }
if bool(TopLevel) then
EnumChildWindows(hWin,lpprocCountWindow,0);
CountWindow := true; { TRUE to continue enumeration }
end { CountWindow };
function DoScrollMsg(hWin : hwnd; { Window handle to scroll }
nbar : integer; { SB_HORZ or SB_VERT }
wCode : word; { Scroll bar message code }
nThumb : integer) : integer; { Thumb position }
{
Process a scroll bar message. Calculates the distance to scroll based
on the scroll bar range and the message code. Limits the scroll to the
actual range of the scroll bar. Sets the new scroll bar thumb position
and scrolls the window by the necessary amount. Note that the scroll
bar ranges are set in terms of number of characters, while the window
scrolling is done by a number of pixels. Returns the distance scrolled
in chars.
}
var
XAmount,
YAmount,
nOld, { Previous scroll bar position }
nDiff, { Amount to change scroll bar by }
nMin, { Minimum value of scroll bar range }
nMax, { Maximum value of scroll bar range }
nPageSize : integer; { Size of our window in characters }
rect : trect; { Client rectangle for our window }
begin
DoScrollMsg := 0;
{ Get old scroll position and scroll range }
nOld := GetScrollPos(hWin,nBar);
GetScrollRange(hWin,nBar,nMin,nMax);
{ Quit if there is nowhere to scroll to (see SetScrollBars) }
if nMax = maxint then exit;
{ Calculate page size, horizontal or vertical as needed }
GetClientRect(hWin,rect);
if nBar = sb_horz then
nPageSize := (rect.right - rect.left) div nCharSizeX
else
nPageSize := (rect.bottom - rect.top) div nCharSizeY;
{ Select the amount to scroll by, based on the scroll message }
case wCode of
sb_lineup : nDiff := -1;
sb_linedown : nDiff := 1;
sb_pageup : nDiff := -nPageSize;
sb_pagedown : nDiff := nPageSize;
sb_thumbposition : nDiff := nThumb - nOld;
sb_top : ndiff := -30000; { kludgey, but effective }
sb_Bottom : nDiff := 30000;
else
exit;
end;
{ Limit scroll destination to nMin..nMax }
if nDiff < nMin - nOld then nDiff := nMin - nOld;
if nDiff > nMax - nOld then nDiff := nMax - nOld;
if nDiff = 0 then exit; { Return if net effect is nothing }
{ OK, now we can set the new position and scroll the window }
SetScrollPos(hWin,nBar,nOld + nDiff,true);
if nBar = sb_horz then
begin
XAmount := -nDiff * nCharSizeX;
YAmount := 0;
end
else
begin
XAmount := 0;
YAmount := -nDiff * nCharSizeY;
end;
ScrollWindow(hWin,XAmount,YAmount,nil,nil);
{ Force an immediate update for cleaner appearance }
UpdateWindow(hWin);
DoScrollMsg := nDiff;
end { DoScrollMsg };
procedure HomeScrollBars(hWin : hwnd; { Window handle }
Redraw : bool);
{
Set both scroll bars to the home position (0). Redraw is TRUE if scroll
bars should be redrawn.
}
begin
SetScrollPos(hWin,sb_horz,0,Redraw);
SetScrollPos(hWin,sb_vert,0,Redraw);
end { HomeScrollBars };
procedure SetScrollBar1(hWin : hwnd; { Window handle }
SBar, { Which scroll bar, SB_HORZ or SB_VERT }
Max : integer); { Value to set max range to }
{
Set one scroll bar's maximum range. We always set the minimum to zero,
although Windows allows other values. There is one case we handle
specially. If you set a scroll bar range to minimum==maximum (maximum =
zero for us), Windows does not actually set the range, but instead turns
off the scroll bar completely, changing the window style by turning off
the WS_HSCROLL or WS_VSCROLL bit. For example, this is how the MS-DOS
Executive makes its scroll bars appear and disappear. This behavior is
fine if you take it into account in your programming in two ways.
First, whenever you do a GetScrollRange you must first check the window
style to see if that scroll bar still exists, because you willnot* get
the correct answer from GetScrollRange if it has been removed. Second,
you must be prepared to get some extra WM_SIZE messages, because your
client area changes size when the scroll bars appear and disappear.
This can cause some sloppy looking screen painting. We take a different
approach, always keeping the scroll bars visible. If the scroll bar
range needs to be set to zero, instead we set it to MAXINT so the bar
remains visible. Then, in DoScrollMessage we check for this case and
return without scrolling.
}
var
OldMin, { Previous minimum value (always 0) }
OldMax : integer; { Previous maximum value }
begin
{ Check for a negative or zero range and set our special case flag.
Also, set the thumb position to zero in this case. }
if Max <= 0 then begin
Max := maxint;
DoScrollMsg(hWin,SBar,sb_thumbposition,0);
end;
{ Find out the previous range, and set it if it has changed }
GetScrollRange(hWin,SBar,OldMin,OldMax);
if Max <> OldMax then
SetScrollRange(hWin,SBar,0,Max,true);
end { SetScrollBar1 };
procedure SetScrollBars(hWin : hwnd); { Window handle }
{
Set horizontal and vertical scroll bars, based on the window size and
the number of INFO entries. The scroll bar ranges are set to give a
total width of WINDOW_WIDTH and a total height equal to the number of
lines of information available. For example, if there are 130 lines of
information and the window height is 10 characters, the vertical scroll
range is set to 120 (130-10). This lets you scroll through everything
and still have a full window of information at the bottom. (Unlike,
say, Windows Write, where if you scroll to the bottom you have a blank
screen.)
}
var
Rect : trect; { The window's client rectangle }
begin
GetClientRect(hWin,Rect);
SetScrollBar1(hWin,sb_horz,WindowWidth - (rect.right div nCharSizeX));
SetScrollBar1(hWin,sb_vert,
(nWindows * LinesPerWin) - (rect.bottom div nCharSizeY));
end { SetScrollBars };
function SpyOnAllWindows(hWin : hwnd) : bool; { Window handle }
{
Loop through all windows in the system and gather up information for the
INFO array for each. Use the EnumWindows and EnumChildWindows functions
to loop through them. We actually loop through them twice: first, to
simply count them so we can allocate global memory for the INFO array,
and again to actually fill in the array. After gathering up the
information, we invalidate our window, which will cause a WM_PAINT
message to be posted, so it will get repainted.
}
begin
{ Calculate the number of windows and amount of memory needed }
nWindows := 0;
dwInfoSize := 0;
EnumWindows(lpprocCountWindow,1);
{ Allocate the memory, complain if we couldn't get it }
hInfo := GlobalReAlloc(hInfo,dwInfoSize,gmem_moveable);
if hInfo = 0 then begin
nWindows := 0;
dwInfoSize := 0;
GlobalFree(hInfo);
MessageBox(GetActiveWindow,'Insufficient memory!!',nil,
mb_ok or mb_iconhand);
PostQuitMessage(0);
SpyOnAllWindows := false;
exit;
end;
{ Lock down the memory and fill in the information, then unlock it }
pInfo := GlobalLock(hInfo);
InfoIndex := 0;
EnumWindows(lpprocSpyOnWindow,1);
GlobalUnlock(hInfo);
{ Set the scroll bars based on new window count, repaint our window }
SetScrollBars(hWin);
HomeScrollBars(hWin,true);
InvalidateRect(hWin,nil,true);
SpyOnAllWindows := true;
end { SpyOnAllWindows };
procedure Paint( szFormat : pchar; { Format string }
var Args); { parameters }
{
Format and paint a line of text. szFormat and Args are just as in a
sprintf() call (Args is a variable number of arguments). The global
variables nPaintX and nPaintY tell where to paint the line. We
increment nPaintY to the next line after painting.
}
var
nLength : integer; { Length of formatted string }
Buf : array[0..160] of char; { Buffer to format string into }
begin
nLength := wvsprintf(Buf,szFormat,Args);
TextOut(hdcPaint,nPaintX,nPaintY+nExtLeading,Buf,nLength);
inc(nPaintY,nCharSizeY);
end { Paint };
procedure PaintWindow(hWin : hwnd); { Window handle to paint }
{
Paints our window or any portion of it that needs painting.
The BeginPaint call sets up a structure that tells us what rectangle of
the window to paint, along with other information for the painting
process. First, erase the background area if necessary. Then,
calculate the index into the INFO array to start with, based on the
painting rectangle and the scroll bar position, and lock down the INFO.
Finally, loop through the INFO array, painting the text for each entry.
Quit when we run out of entries or hit the bottom of the paint
rectangle.
}
type
TOneLiner = record { parameters for wvsprintf }
v1 : pchar;
v2 : word;
v3 : pchar;
v4,
v5,
v6,
v7 : integer;
v8 : pchar;
end;
THandleParam = record
v1 : pchar;
v2 : hwnd;
end;
TWordParam = record
v1,
v2,
v3,
v4 : word;
end;
TIntParam = record
v1,
v2,
v3,
v4 : integer;
end;
TStyleParam = record
v1 : word;
v2 : longint;
end;
var
ps : tpaintstruct; { Paint structure used by BeginPaint }
rgbOldTextColor, { Old text color (so we can restore it) }
rgbOldBkColor : longint; { Old background color }
nWin, { Index into INFO array }
X, { X position for paint calculation }
Y : integer; { Y position for paint calculation }
pTypeName : pchar; { Pointer to "Child", etc. string }
ExpandFactor : integer;
OneLiner : TOneLiner;
HandleParam : THandleParam;
WordParam : TWordParam;
IntParam : TIntParam;
StyleParam : TStyleParam;
SaveFont : hfont; { Saved device context font }
begin
{ Tell Windows we're painting, set up the paint structure. }
BeginPaint(hWin,ps);
{ Store display context in global for Paint function }
hdcPaint := ps.hdc;
{ Get our font }
SaveFont := SelectObject(ps.hdc,GetStockObject(SpyFont));
{ Set up proper background and text colors and save old values }
rgbOldBkColor := SetBkColor(ps.hdc,GetSysColor(color_window));
rgbOldTextColor := SetTextColor(ps.hdc,GetSysColor(color_windowtext));
{ Calculate horizontal paint position based on scroll bar position }
X := (1 - GetScrollPos(hWin,sb_horz)) * nCharSizeX;
{ Calculate index into INFO array and vertical paint position, based
on scroll bar position and top of painting rectangle }
Y := GetScrollPos(hWin,sb_vert);
nWin := (ps.rcPaint.top div nCharSizeY + Y) div LinesPerWin;
nPaintY := (nWin * LinesPerWin - Y) * nCharSizeY;
{ Lock down INFO array. nWin is index to first entry to paint }
pInfo := GlobalLock(hInfo);
{ Loop through INFO entries, painting each one until we run out of
entries or until we are past the bottom of the paint rectangle. We
don't worry much about painting outside the rectangle - Windows will
clip for us. }
while (nWin < nWindows) and (nPaintY < ps.rcPaint.bottom) do begin
{ Set X position and indent child windows, also set up pTypeName }
nPaintX := X;
if bool(pInfo^[nWin].winStyle and ws_child) then
begin
if bExpand then
ExpandFactor := 4
else
ExpandFactor := 2;
inc(nPaintX,nCharSizeX * Expandfactor);
pTypeName := 'Child';
end
else
if bool(pInfo^[nWin].winStyle and ws_iconic) then
pTypeName := 'Icon'
else
if bool(pInfo^[nWin].winStyle and ws_popup) then
pTypeName := 'Popup'
else
pTypeName := 'Top Level';
if not bExpand then
begin
{ Paint the one-liner }
with OneLiner do begin
v1 := pTypeName;
v2 := pInfo^[nWin].winHWnd;
v3 := pInfo^[nWin].winClass;
v4 := pInfo^[nWin].winWindowRect.left;
v5 := pInfo^[nWin].winWindowRect.top;
v6 := pInfo^[nWin].winWindowRect.right;
v7 := pInfo^[nWin].winWindowRect.bottom;
v8 := pInfo^[nWin].winTitle;
end;
Paint('%s window %04X {%s} (%d,%d;%d,%d) "%s"',OneLiner);
end
else
begin
{ Paint the expanded form, first the window handle }
with HandleParam do begin
v1 := pTypeName;
v2 := pInfo^[nWin].winHWnd;
end;
Paint('%s window handle: %04X',HandleParam);
{ Paint the rest of the info, indented two spaces farther over }
inc(nPaintX,nCharSizeX * 2);
with HandleParam do v1 := pInfo^[nWin].winClass;
Paint('Class name: %s',HandleParam);
with HandleParam do v1 := pInfo^[nWin].winTitle;
Paint('Window title: %s',HandleParam);
Paint('Parent window handle: %04X',pInfo^[nWin].winHWndParent);
with WordParam do begin
v1 := hiword(pInfo^[nWin].WinClassProc);
v2 := loword(pInfo^[nWin].WinClassProc);
v3 := hiword(pInfo^[nWin].WinWndProc);
v4 := loword(pInfo^[nWin].WInWndProc);
end;
Paint('Class function, Window function: %04X:%04X, %04X:%04X',WordParam);
with WordParam do begin
v1 := pInfo^[nWin].winClassModule;
v2 := pInfo^[nWin].winInstance;
end;
Paint('Class module handle, Window instance handle: %04X, %04X',WordParam);
with WordParam do begin
v1 := pInfo^[nWin].winClsExtra;
v2 := pInfo^[nWin].winWndExtra;
end;
Paint('Class extra alloc, Window extra alloc: %d, %d',WordParam);
with StyleParam do begin
v1 := pInfo^[nWin].winClassStyle;
v2 := pInfo^[nWin].winStyle;
end;
Paint('Class style, Window style: %04X, %08lX',StyleParam);
if bool(pInfo^[nWin].winStyle and ws_child) then
Paint('Control ID: %d',pInfo^[nWin].winControlID)
else
Paint('Menu handle: %04X',pInfo^[nWin].winControlID);
with WordParam do begin
v1 := pInfo^[nWin].winBkgdBrush;
v2 := pInfo^[nWin].winCursor;
v3 := pInfo^[nWin].winIcon;
end;
Paint('Brush, Cursor, Icon handles: %04X, %04X, %04X',WordParam);
with IntParam do begin
v1 := pInfo^[nWin].winWindowRect.left;
v2 := pInfo^[nWin].winWindowRect.top;
v3 := pInfo^[nWin].winWindowRect.right;
v4 := pInfo^[nWin].winWindowRect.bottom;
end;
Paint('Window rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d',IntParam);
with IntParam do begin
v1 := pInfo^[nWin].winClientRect.left;
v2 := pInfo^[nWin].winClientRect.top;
v3 := pInfo^[nWin].winClientRect.right;
v4 := pInfo^[nWin].winClientRect.bottom;
end;
Paint('Client rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d',IntParam);
{ Make a blank line - it's already erased so just increment Y }
inc(nPaintY,nCharSizeY);
end;
{ Increment to next INFO entry }
inc(nWin);
end; { while }
{ Unlock the INFO array }
GlobalUnlock(hInfo);
{ Restore old colors }
SetBkColor(ps.hdc,rgbOldBkColor);
SetTextColor(ps.hdc,rgbOldTextColor);
{ Restore original font }
SelectObject(ps.hdc,SaveFont);
{ Tell Windows we're done painting }
EndPaint(hWin,ps);
end { PaintWindow };
procedure SetSpyFont(hWin : hwnd;
NewFontCmd : word);
{
Calculates character height and width for the specified font and stores
the values in global variables. Also checks the appropriate item on the
Font menu. This routine is new in TPWSpy.
}
var
DC : hdc;
SaveFont : hfont;
Metrics : ttextmetric; { Text metrics for our font }
begin
DC := GetDC(hWin);
SaveFont := SelectObject(DC,GetStockObject(FontTable[NewFontCmd]));
GetTextMetrics(DC,Metrics);
SelectObject(DC,SaveFont);
ReleaseDC(hWin,DC);
nExtLeading := Metrics.tmExternalLeading;
nCharSizeX := Metrics.tmMaxCharWidth;
nCharSizeY := Metrics.tmHeight + Metrics.tmExternalLeading;
CheckMenuItem(GetMenu(hWin),SpyFontCmd,mf_unchecked);
CheckMenuItem(GetMenu(hWin),NewFontCmd,mf_checked);
SpyFont := FontTable[NewFontCmd];
SpyFontCmd := NewFontCmd;
end { SetSpyFont };
procedure ChangeFont(hWin : hwnd;
NewFontCmd : word);
{
Selects a new stock font and invalidates our window so it will be
repainted. This routine is new in TPWSpy.
}
begin
SetSpyFont(hWin,NewFontCmd);
InvalidateRect(hWin,nil,true);
HomeScrollBars(hWin,false);
SetScrollBars(hWin);
end { ChangeFont };
function SpyWndProc(hWin : hwnd; { Window handle }
Msg, { message number }
WParam : word; { word param }
LParam : longint) : longint; export; { long param }
{
Window function for our main window. All messages for our window are
sent to this function. For messages that we do not handle here, we call
DefWindowProc, which performs Windows' default processing for a message.
}
begin
SpyWndProc := 0;
case Msg of
{ Menu command message - process the command }
wm_Command :
if LoWord(lParam) = 0 then
case WParam of
Cmd_Expand :
begin
bExpand := not bExpand;
if bExpand then
begin
LinesPerWin := MaxLinesPerWin;
CheckMenuItem(GetMenu(hWin),Cmd_Expand,mf_checked);
end
else
begin
LinesPerWin := 1;
CheckMenuItem(GetMenu(hWin),Cmd_Expand,mf_unchecked);
end;
InvalidateRect(hWin,nil,true);
HomeScrollBars(hWin,false);
SetScrollBars(hWin);
exit;
end;
Cmd_Spy :
begin
SpyOnAllWindows(hWin);
exit;
end;
Cmd_OEMFixedFont..Cmd_SystemFont :
begin
ChangeFont(hWin,WParam);
exit;
end;
end;
{ Horizontal scroll message - scroll the window }
wm_HScroll :
begin
DoScrollMsg(hWin,sb_horz,WParam,LParam);
exit;
end;
{ Vertical scroll message - scroll the window }
wm_VScroll :
begin
DoScrollMsg(hWin,sb_vert,WParam,LParam);
exit;
end;
{ Key-down message - handle cursor keys, ignore other keys }
wm_KeyDown :
begin
if (WParam >= vk_MinCursor) and (WParam <= vk_MaxCursor) then
DoScrollMsg(hWin,
CsrScroll[WParam - vk_MinCursor].csBar,
CsrScroll[WParam - vk_MinCursor].csMsg,
0);
exit;
end;
{ Paint message - repaint all or part of our window }
wm_Paint :
begin
PaintWindow(hWin);
exit;
end;
{ Size message - recalculate our scroll bars to take the new size
into account, but only if initialization has been completed. There
are several superfluous WM_SIZE messages sent during initialization,
and it looks ugly if we repaint the scroll bars for all these. }
wm_Size :
begin
if Initted then
SetScrollBars(hWin);
exit;
end;
{ Destroy-window message - time to quit the application }
wm_Destroy :
begin
PostQuitMessage(0);
exit;
end;
end;
{ For all other messages, we pass them on to DefWindowProc }
SpyWndProc := DefWindowProc(hWin,Msg,WParam,LParam);
end { SpyWndProc };
function SpyOnWindow(hWin : hwnd; { Window handle }
TopLevel : longint) : bool; export;
{
Enumeration function to gather up the information for a single window
and store it in the INFO array entry pointed to by pInfo. Increment
InfoIndex to the next entry afterward. Called once for each window, via
EnumWindows for each top level and popup window, and recursively via
EnumChildWindows for child windows. The TopLevel parameter tells which
kind of call it is. 1=top level window, 0=child window.
}
begin
{ Gather up this window's information }
pInfo^[InfoIndex].winHWnd := hWin;
GetClassName(hWin,pInfo^[InfoIndex].winClass,ClassMax);
pInfo^[InfoIndex].winClass[ClassMax - 1] := #0;
pInfo^[InfoIndex].winInstance := GetWindowWord(hWin,gww_hinstance);
pInfo^[InfoIndex].winHWndParent := GetParent(hWin);
GetWindowText(hWin,pInfo^[InfoIndex].winTitle,TitleMax);
pInfo^[InfoIndex].winTitle[TitleMax - 1] := #0;
pInfo^[InfoIndex].winControlID := GetWindowWord(hWin,gww_id);
pInfo^[InfoIndex].winWndProc := GetWindowLong(hWin,gwl_wndproc);
pInfo^[InfoIndex].winStyle := GetWindowLong(hWin,gwl_style);
GetClientRect(hWin,pInfo^[InfoIndex].winClientRect);
GetWindowRect(hWin,pInfo^[InfoIndex].winWindowRect);
{ Gather up class information }
pInfo^[InfoIndex].winBkgdBrush := GetClassWord(hWin,gcw_HBRBACKGROUND );
pInfo^[InfoIndex].winCursor := GetClassWord(hWin,gcw_HCURSOR );
pInfo^[InfoIndex].winIcon := GetClassWord(hWin,gcw_HICON );
pInfo^[InfoIndex].winClassModule := GetClassWord(hWin,gcw_hmodule);
pInfo^[InfoIndex].winWndExtra := GetClassWord(hWin,gcw_cbwndextra);
pInfo^[InfoIndex].winClsExtra := GetClassWord(hWin,gcw_cbclsextra);
pInfo^[InfoIndex].winClassStyle := GetClassWord(hWin,gcw_style);
pInfo^[InfoIndex].winClassProc := GetClassLong(hWin,gcl_wndproc);
{ Move on to next entry in table }
inc(InfoIndex);
{ If it's a top level window, get its children too }
if bool(TopLevel) then
EnumChildWindows(hWin,lpprocSpyOnWindow,0);
SpyOnWindow := true; { TRUE to continue enumeration }
end { SpyOnWindow };
function Initialize(hPrevInst : thandle;
Show : integer) : bool;
{
Initialize the application. Some of the initialization is different
depending on whether this is the first instance or a subsequent
instance. For example, we register our window class only in the first
instance. Returns TRUE if initialization succeeded, FALSE if failed.
If hPrevInst is 0, then this is the first instance. Show is CmsShow
parameter from WinMain for ShowWindow.
}
var
Class : twndclass; { Class structure for RegisterClass }
hWin : hwnd; { Our window handle }
OurhDC : HDC; { Display context for our window }
hSysMenu : hmenu; { Menu handle of system menu }
ScreenX,
ScreenY : integer;
begin
ScreenX := GetSystemMetrics(sm_cxscreen);
ScreenY := GetSystemMetrics(sm_cyscreen);
Initialize := false;
if hPrevInst = 0 then
begin
{ Initialization for first instance only }
{ Load strings from resource file }
LoadString(hInst,Ids_Class,szClass,sizeof(szClass));
LoadString(hInst,Ids_Title,szTitle,sizeof(szTitle));
{ Register our window class }
Class.style := cs_hredraw or cs_vredraw;
Class.lpfnWndProc := @SpyWndProc;
Class.cbClsExtra := 0;
Class.cbWndExtra := 0;
Class.hInstance := hInst;
Class.hIcon := LoadIcon(hInst,szClass);
Class.hCursor := LoadCursor(0,idc_arrow);
Class.hbrBackground := color_window + 1;
Class.lpszMenuName := szClass;
Class.lpszClassName := szClass;
if not RegisterClass(Class) then
exit;
end
else
begin
{ Initialization for subsequent instances only }
{ Copy data from previous instance }
GetInstanceData(hPrevInst,ofs(szClass),sizeof(szClass));
GetInstanceData(hPrevInst,ofs(szTitle),sizeof(szTitle));
end;
{ Initialization for every instance }
{ Set up ProcInstance pointers for our Enumerate functions }
lpprocCountWindow := MakeProcInstance(@CountWindow,hInst);
lpprocSpyOnWindow := MakeProcInstance(@SpyOnWindow,hInst);
if (lpprocCountWindow = nil) or (lpprocSpyOnWindow = nil) then
exit;
{ Allocate our INFO array with nothing really allocated yet }
hInfo := GlobalAlloc(gmem_moveable,1);
if hInfo = 0 then
exit;
{ Create our tiled window but don't display it yet }
hWin := CreateWindow(
szClass, { Class name }
szTitle, { Window title }
ws_tiledwindow or ws_hscroll or ws_vscroll, { Window style }
(ScreenX * 1) div 20, { X: 5% from left }
(ScreenY * 1) div 10, { Y: 10% from top }
(ScreenX * 9) div 10, { nWidth: 90% }
(ScreenY * 7) div 10, { nHeight: 70% }
0, { Parent hWnd (none for top-level) }
0, { Menu handle }
hInst, { Owning instance handle }
nil); {Parameter to pass in WM_CREATE (none) }
{ Initialize scroll bars - Windows doesn't do this for us }
HomeScrollBars(hWin,false);
{ Calculate character size for the font we'll be using }
SetSpyFont(hWin,DefaultFontCmd);
{ Make the window visible before grabbing spy info, so it's included }
ShowWindow(hWin,Show);
{ Now grab the spy information }
if not SpyOnAllWindows(hWin) then
exit;
{ Got all the information, update our display }
UpdateWindow(hWin);
{ Make note that initialization is complete. This is checked in our
routine that handles WM_SIZE to eliminate some jitter on startup }
Initted := true;
Initialize := true;
end { Initialize };
procedure WinMain;
{
Application main program. Not much is done here - we just initialize
the application, putting up our window, and then we go into the typical
message dispatching loop that every Windows application has.
(Translator's note: hInstance, hPrevInst, and CmdShow are declared in
the SYSTEM unit.)
}
var
Msg : tmsg; { Message structure }
begin
{ Save our instance handle in static variable }
hInst := hInstance;
{ Initialize application, quit if any errors }
if not Initialize(hPrevInst,CmdShow) then
halt(255);
{ Main message processing loop. Get each message, then translate
keyboard messages, and finally dispatch each message to its window
function. }
while GetMessage(Msg,0,0,0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
halt(msg.wParam);
end { WinMain };
begin
WinMain;
end.